home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / POPL.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-01-25  |  31.9 KB  |  939 lines  |  [TEXT/.Ob4]
  1. Syntax10b.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. FoldElems
  5. Syntax10.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7.     PROCEDURE OutRefs* (obj: OPT.Object);
  8.         VAR f: SHORTINT;
  9.     BEGIN
  10.         IF obj # NIL THEN
  11.             OutRefs(obj^.left);
  12.             IF (obj^.mode = Var) OR (obj^.mode = VarPar) THEN
  13.                 f := obj^.typ^.form;
  14.                 IF (f IN {Byte .. Set, Pointer})
  15.                     OR (obj^.typ^.comp = Array) & (obj^.typ^.BaseTyp^.form = Char) & (obj^.typ^.size <= 32) THEN
  16.                     IF obj^.mode = Var THEN OPM.RefW(1X) ELSE OPM.RefW(3X) END ;
  17.                     IF obj^.typ^.comp = Array THEN OPM.RefW(0FX)
  18.                     ELSE OPM.RefW(SYSTEM.VAL(CHAR, f))
  19.                     END;
  20.                     OutNum(obj^.linkadr);
  21.                     OutRefName(obj^.name)
  22.                 END
  23.             END;
  24.             OutRefs(obj^.right)
  25.         END
  26.     END OutRefs;
  27. MODULE POPL;    (* mmb 17.1.91 / 31.5.94 *)
  28.     IMPORT
  29.         OPT := POPT, OPM := POPM, SYSTEM;
  30.     CONST
  31.         (* structure forms *)
  32.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  33.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  34.         Pointer = 13; ProcTyp = 14; Comp = 15;
  35.         (* structure sets *)
  36.         RealTypes = {Real, LReal};
  37.         SimpleTypes = {Byte, Bool, Char, SInt, Int, LInt, Real, LReal, Set, NilTyp, Pointer};
  38.         (* composite structure forms *)
  39.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  40.         (* item/object modes *)
  41.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; SProc = 8; CProc = 9; IProc = 10;
  42.         Head = 12; TProc = 13; Based = 14; Indexed = 15; Reg = 16; RegSI = 17; FReg = 18; Cond = 19;
  43.         (* module visibility of objects *)
  44.         internal = 0; external = 1; externalR = 2;
  45.         (* procedure flags (conval^.setval) *)
  46.         hasBody = 1; isRedef = 2; alreadyCalled = 3;
  47.         (* fields in the POWER architecture instruction encoding *)
  48.         fAA = 00000002H;
  49.         fBA = 00010000H;
  50.         fBB = 00000800H;
  51.         fBD = 00000004H;
  52.         fBF = 00800000H;
  53.         fBFA = 00040000H;
  54.         fBI = 00010000H;
  55.         fBO = 00200000H;
  56.         fBT = 00200000H;
  57.         fD = 00000001H;
  58.         fEO = 00000002H;
  59.         fEO1 = 00000002H;
  60.         fFXM = 00001000H;
  61.         fFLM = 00020000H;
  62.         fFRA = 00010000H;
  63.         fFRB = 00000800H;
  64.         fFRC = 00000040H;
  65.         fFRS = 00200000H;
  66.         fFRT = 00200000H;
  67.         fI = 00001000H;
  68.         fLI = 00000004H;
  69.         fMB = 00000040H;
  70.         fME = 00000002H;
  71.         fNB = 00000800H;
  72.         fOE = 00000400H;
  73.         fOPCD = 04000000H;
  74.         fRA = 00010000H;
  75.         fRB = 00000800H;
  76.         fRS = 00200000H;
  77.         fRT = 00200000H;
  78.         fSH = 00000800H;
  79.         fSI = 00000001H;
  80.         fSPR = 00010000H;
  81.         fTO = 00200000H;
  82.         fLK = 00000001H;
  83.         fUI = 00000001H;
  84.         fXO = 00000002H;
  85.         REC = 1;
  86.         (* opcodes, POWER architecture *)
  87.         iA =  7C000014H;
  88.         iABS =  7C0002D0H;
  89.         iAE =  7C000114H;
  90.         iAI =  30000000H;
  91.         iAME =  7C0001D4H;
  92.         iAND =  7C000038H;
  93.         iANDC =  7C000078H;
  94.         iANDIL =  70000000H;
  95.         iANDIU =  74000000H;
  96.         iAZE =  7C000194H;
  97.         iB =  48000000H;
  98.         iBC =  40000000H;
  99.         iBCC =  4C000420H;
  100.         iBCR =  4C000020H;
  101.         iCAL =  38000000H;
  102.         iCAU =  3C000000H;
  103.         iCAX =  7C000214H;
  104.         iCLCS =  7C000426H;
  105.         iCLF =  7C0000ECH;
  106.         iCLI =  7C0003ECH;
  107.         iCMP =  7C000000H;
  108.         iCMPI =  2C000000H;
  109.         iCMPL =  7C000040H;
  110.         iCMPLI =  28000000H;
  111.         iCNTLZ =  7C000034H;
  112.         iCRAND =  4C000202H;
  113.         iCRANDC =  4C000102H;
  114.         iCREQV =  4C000242H;
  115.         iCRNAND =  4C0001C2H;
  116.         iCRNOR =  4C000042H;
  117.         iCROR =  4C000382H;
  118.         iCRORC =  4C000342H;
  119.         iCRXOR =  4C000182H;
  120.         iDCLST =  7C0004ECH;
  121.         iDCLZ =  7C0007ECH;
  122.         iDCS =  7C0004ACH;
  123.         iDIV =  7C000296H;
  124.         iDIVS =  7C0002D6H;
  125.         iDOZ =  7C000210H;
  126.         iDOZI =  24000000H;
  127.         iEQV =  7C000238H;
  128.         iEXTS =  7C000734H;
  129.         iFA = 0FC00002AH;
  130.         iFABS = 0FC000210H;
  131.         iFCMPO = 0FC000040H;
  132.         iFCMPU = 0FC000000H;
  133.         iFD = 0FC000024H;
  134.         iFM = 0FC000032H;
  135.         iFMA = 0FC00003AH;
  136.         iFMR = 0FC000090H;
  137.         iFMS = 0FC000038H;
  138.         iFNABS = 0FC000110H;
  139.         iFNEG = 0FC000050H;
  140.         iFNMA = 0FC00003EH;
  141.         iFNMS = 0FC00003CH;
  142.         iFRSP = 0FC000018H;
  143.         iFS = 0FC000028H;
  144.         iICS =  4C00012CH;
  145.         iL = 080000000H;
  146.         iLBRX =  7C00042CH;
  147.         iLBZ = 088000000H;
  148.         iLBZU = 08C000000H;
  149.         iLBZUX =  7C0000EEH;
  150.         iLBZX =  7C0000AEH;
  151.         iLFD = 0C8000000H;
  152.         iLFDU = 0CC000000H;
  153.         iLFDUX =  7C0004EEH;
  154.         iLFDX =  7C0004AEH;
  155.         iLFS = 0C0000000H;
  156.         iLFSU = 0C4000000H;
  157.         iLFSUX =  7C00046EH;
  158.         iLFSX =  7C00042EH;
  159.         iLHA = 0A8000000H;
  160.         iLHAU = 0AC000000H;
  161.         iLHAUX =  7C0002EEH;
  162.         iLHAX =  7C0002AEH;
  163.         iLHBRX =  7C00062CH;
  164.         iLHZ = 0A0000000H;
  165.         iLHZU = 0A4000000H;
  166.         iLHZUX =  7C00026EH;
  167.         iLHZX =  7C00022EH;
  168.         iLM = 0B8000000H;
  169.         iLSCBX =  7C00022AH;
  170.         iLSI =  7C0004AAH;
  171.         iLSX =  7C00042AH;
  172.         iLU = 084000000H;
  173.         iLUX =  7C00006EH;
  174.         iLX =  7C00002EH;
  175.         iMASKG =  7C00003AH;
  176.         iMASKIR =  7C00043AH;
  177.         iMCRF =  4C000000H;
  178.         iMCRFS = 0FC000080H;
  179.         iMCRXR =  7C000400H;
  180.         iMFCR =  7C000026H;
  181.         iMFFS = 0FC00048EH;
  182.         iMFMSR =  7C0000A6H;
  183.         iMFSPR =  7C0002A6H;
  184.         iMFSR =  7C0004A6H;
  185.         iMFSRI =  7C0004E6H;
  186.         iMTCRF =  7C000120H;
  187.         iMTFSB0 = 0FC00008CH;
  188.         iMTFSB1 = 0FC00004CH;
  189.         iMTFSF = 0FC00058EH;
  190.         iMTSFI = 0FC00010CH;
  191.         iMTMSR =  7C000124H;
  192.         iMTSPR =  7C0003A6H;
  193.         iMTSR =  7C0001A4H;
  194.         iMTSRI =  7C0001E4H;
  195.         iMUL =  7C0000D6H;
  196.         iMULI =  1C000000H;
  197.         iMULS =  7C0001D6H;
  198.         iNABS =  7C0003D0H;
  199.         iNAND =  7C0003B8H;
  200.         iNEG =  7C0000D0H;
  201.         iNOR =  7C0000F8H;
  202.         iOR =  7C000378H;
  203.         iORC =  7C000338H;
  204.         iORIL =  60000000H;
  205.         iORIU =  64000000H;
  206.         iRAC =  7C000664H;
  207.         iRFI =  4C000064H;
  208.         iRFSVC =  4C0000A4H;
  209.         iRLIMI =  50000000H;
  210.         iRLINM =  54000000H;
  211.         iRLMI =  58000000H;
  212.         iRLNM =  5C000000H;
  213.         iRRIB =  7C000432H;
  214.         iSF =  7C000010H;
  215.         iSFE =  7C000110H;
  216.         iSFI =  20000000H;
  217.         iSFME =  7C0001D0H;
  218.         iSFZE =  7C000190H;
  219.         iSL =  7C000030H;
  220.         iSLE =  7C000132H;
  221.         iSLEQ =  7C0001B2H;
  222.         iSLIQ =  7C000170H;
  223.         iSLLIQ =  7C0001F0H;
  224.         iSLLQ =  7C0001B0H;
  225.         iSLQ =  7C000130H;
  226.         iSR =  7C000430H;
  227.         iSRA =  7C000630H;
  228.         iSRAI =  7C000670H;
  229.         iSRAIQ =  7C000770H;
  230.         iSRAQ =  7C000730H;
  231.         iSRE =  7C000532H;
  232.         iSREA =  7C000732H;
  233.         iSREQ =  7C0005B2H;
  234.         iSRIQ =  7C000570H;
  235.         iSRLIQ =  7C0005F0H;
  236.         iSRLQ =  7C0005B0H;
  237.         iSRQ =  7C000530H;
  238.         iST = 90000000H;
  239.         iSTB = 98000000H;
  240.         iSTBRX =  7C00052CH;
  241.         iSTBU = 9C000000H;
  242.         iSTBUX =  7C0001EEH;
  243.         iSTBX =  7C0001AEH;
  244.         iSTFD = 0D8000000H;
  245.         iSTFDU = 0DC000000H;
  246.         iSTFDUX =  7C0005EEH;
  247.         iSTFDX =  7C0005AEH;
  248.         iSTFS = 0D0000000H;
  249.         iSTFSU = 0D4000000H;
  250.         iSTFSUX =  7C00056EH;
  251.         iSTFSX =  7C00052EH;
  252.         iSTH = 0B0000000H;
  253.         iSTHBRX =  7C00072CH;
  254.         iSTHU = 0B4000000H;
  255.         iSTHUX =  7C00036EH;
  256.         iSTHX =  7C00032EH;
  257.         iSTM = 0BC000000H;
  258.         iSTSI =  7C0005AAH;
  259.         iSTSX =  7C00052AH;
  260.         iSTU = 94000000H;
  261.         iSTUX =  7C00016EH;
  262.         iSTX =  7C00012EH;
  263.         iSVC =  44000000H;
  264.         iT =  7C000008H;
  265.         iTI =  0C000000H;
  266.         iTLBI =  7C000264H;
  267.         iXOR =  7C000278H;
  268.         iXORIL =  68000000H;
  269.         iXORIU =  6C000000H;
  270.         iMR = iCAL;
  271.         iMTCR = iMTCRF+0FFH*fFXM;
  272.         (* special register definitions *)
  273.         SB = 2; SP = 1; FP = 31; SLpar = 11; virtualFP = 32; spCTR = 9; spMQ = 0; spLR = 8;
  274.         (* register allocation parameters *)
  275.         SaveRlimit = 12;
  276.         SaveFlimit = 13;
  277.         TempRegs* = {3..12};
  278.         TempFRegs* = {0..13};
  279.         TempCRFields* = {1,6,7};
  280.         TempCRBits* = {4..7,24..31};
  281.         cALWAYS = 1FH;
  282.         (* RTS procedure tags *)
  283.         SYSMTag = 0FFX; NewETag = 0FFX; SYSnewETag = 0FEX;
  284.         LinkMTag = 0FEX; CaseETag = 0FFX; CaseE2Tag = 0FEX;
  285.         (* various constants *)
  286.         CodeSize = 16384;    (* words *)
  287.         ConstLength = 4096+1024;    (* bytes *)
  288.         MaxComs = 128; MaxExts = 15; MaxRecs = 64;
  289.         MaxLinks = 250; MaxTraps = 2048+256;
  290.         LowWord = 10000H;
  291.         MaxEntry* = 128;
  292.     TYPE
  293.         Item* = RECORD
  294.             mode*, mnolev*, dmode*, dreg*: SHORTINT;
  295.             adr*: LONGINT;
  296.             typ*: OPT.Struct;
  297.             offset*: LONGINT;
  298.             reg*: LONGINT;
  299.             Tjmp*, Fjmp*: INTEGER;
  300.         END;
  301.         Label* = INTEGER;
  302.         LinkEntry = RECORD
  303.             mod, ent: CHAR;
  304.             pos: Label
  305.         END;
  306.         SaveDesc* = RECORD
  307.             savedR, savedF, ParR, ParF: SET;
  308.               CRFreg, offset: LONGINT (* << mmb 7.2.95 *)
  309.         END;
  310.         entno*, level*: INTEGER;
  311.         dsize*: LONGINT;
  312.         linkTable*: LONGINT;
  313.         pc*: LONGINT;
  314.         entry*: ARRAY MaxEntry OF Label;
  315.         TempR, TempF, ParR, ParF, TempCRF, TempCRB, HoldR: SET;
  316.         TempRpos, TempFpos, TempCRFpos, TempCRBpos, SaveRpos, SaveFpos: LONGINT;
  317.         nofrec, noflk, noftraps: INTEGER;
  318.         conx: INTEGER;
  319.         procStart: LONGINT;
  320.         saveStart, SLsize: LONGINT;
  321.         CaseLink: INTEGER;
  322.         recTab: ARRAY MaxRecs OF OPT.Struct;
  323.         code: ARRAY CodeSize OF LONGINT;
  324.         constant: ARRAY ConstLength OF CHAR;
  325.         links: ARRAY MaxLinks OF LinkEntry;
  326.         CRF0used: BOOLEAN;
  327.         SaveFEntry, RestFEntry: ARRAY 31-13 OF LONGINT;
  328.         Traps: ARRAY MaxTraps OF RECORD no, pc: INTEGER END;
  329.     PROCEDURE FreeTempR* (r: LONGINT);
  330.     BEGIN TempR := TempR + {r}*TempRegs - HoldR - ParR
  331.     END FreeTempR;
  332.     PROCEDURE FreeTempF* (r: LONGINT);
  333.     BEGIN TempF := TempF + {r}*TempFRegs - ParF
  334.     END FreeTempF;
  335.     PROCEDURE FreeTempCRBs* (s: SET);
  336.         VAR i: INTEGER; f: SET;
  337.     BEGIN
  338.         IF s*{0..3} # {} THEN CRF0used := FALSE END;
  339.         TempCRB := TempCRB + s*TempCRBits;
  340.         i := 0;
  341.         WHILE i < 32 DO
  342.             f := {i..i+3}; IF f*TempCRB=f THEN TempCRB := TempCRB-f; TempCRF := TempCRF+{i DIV 4} END;
  343.             INC(i, 4)
  344.         END
  345.     END FreeTempCRBs;
  346.     PROCEDURE GetSaveF* (): LONGINT;
  347.         VAR r: LONGINT;
  348.     BEGIN
  349.         ASSERT(SaveFpos > SaveFlimit);
  350.         r := SaveFpos; SaveFpos := r-1; RETURN r
  351.     END GetSaveF;
  352.     PROCEDURE GetSaveR* (): LONGINT;
  353.         VAR r: LONGINT;
  354.     BEGIN
  355.         ASSERT(SaveRpos > SaveRlimit);
  356.         r := SaveRpos; SaveRpos := r-1; RETURN r
  357.     END GetSaveR;
  358.     PROCEDURE GetTempF* (): LONGINT;
  359.         VAR r, t: LONGINT;
  360.     BEGIN
  361.         r := TempFpos; t := r+1;
  362.         WHILE (t # r) & ~(t IN TempF) DO t := (t+1) MOD 32 END;
  363.         IF t IN TempF THEN TempFpos := t; EXCL(TempF, t) ELSE OPM.err(216) END;
  364.         RETURN t
  365.     END GetTempF;
  366.     PROCEDURE GetTempR* (): LONGINT;
  367.         VAR r, t: LONGINT;
  368.     BEGIN
  369.         r := TempRpos; t := r+1;
  370.         WHILE (t # r) & ~(t IN TempR) DO t := (t+1) MOD 32 END;
  371.         IF t IN TempR THEN TempRpos := t; EXCL(TempR, t) ELSE OPM.err(215) END;
  372.         RETURN t
  373.     END GetTempR;
  374.     PROCEDURE GetTempCRF* (): LONGINT;
  375.         VAR r, t: LONGINT;
  376.     BEGIN
  377.         r := TempCRFpos; t := r+1;
  378.         WHILE (t # r) & ~(t IN TempCRF) DO t := (t+1) MOD 8 END;
  379.         IF t IN TempCRF THEN TempCRFpos := t; EXCL(TempCRF, t) ELSE OPM.err(215) END;
  380.         RETURN t
  381.     END GetTempCRF;
  382.     PROCEDURE GetTempCRB* (): LONGINT;
  383.         VAR r, t: LONGINT;
  384.     BEGIN
  385.         IF TempCRB = {} THEN r := GetTempCRF(); TempCRB := {r*4..r*4+3} END;
  386.         r := TempCRBpos; t := r+1;
  387.         WHILE (t # r) & ~(t IN TempCRB) DO t := (t+1) MOD 32 END;
  388.         IF t IN TempCRB THEN TempCRBpos := t; EXCL(TempCRB, t) ELSE OPM.err(215) END;
  389.         RETURN t
  390.     END GetTempCRB;
  391.     PROCEDURE GetCRF0* (): LONGINT;
  392.     BEGIN
  393.         IF CRF0used THEN RETURN GetTempCRF() ELSE CRF0used := TRUE; RETURN 0 END
  394.     END GetCRF0;
  395.     PROCEDURE GetTempRegs* (nrRegs: LONGINT; freeable: SET): LONGINT;
  396.         VAR toGet, free: SET; r, t: LONGINT;
  397.     BEGIN
  398.         r := TempRpos; t := r;
  399.         REPEAT
  400.             t := (t+1) MOD 32; IF t+nrRegs > 32 THEN t := 0 END;
  401.             toGet := {t..t+nrRegs-1}
  402.         UNTIL (t = r) OR (TempR*toGet = toGet);
  403.         IF TempR*toGet = toGet THEN TempR := TempR-toGet; TempRpos := t+nrRegs
  404.         ELSIF freeable # {} THEN free := TempR+freeable;
  405.             REPEAT
  406.                 t := (t+1) MOD 32; IF t+nrRegs > 32 THEN t := 0 END;
  407.                 toGet := {t..t+nrRegs-1}
  408.             UNTIL (t = r) OR (free*toGet = toGet);
  409.             IF free*toGet = toGet THEN TempR := TempR-toGet; TempRpos := t+nrRegs ELSE OPM.err(215) END
  410.         END;
  411.         RETURN t
  412.     END GetTempRegs;
  413.     PROCEDURE FreeTempRegs* (r, nrRegs: LONGINT);
  414.     BEGIN TempR := TempR+{r..r+nrRegs-1}*TempRegs-HoldR
  415.     END FreeTempRegs;
  416.     PROCEDURE LockTempR* (regs: SET);
  417.     BEGIN
  418.         ASSERT(regs-TempR = {}); TempR := TempR-regs
  419.     END LockTempR;
  420.     PROCEDURE LockTempF* (regs: SET);
  421.     BEGIN
  422.         ASSERT(regs-TempF = {}); TempF := TempF-regs
  423.     END LockTempF;
  424.     PROCEDURE HoldTempR* (r: LONGINT);
  425.     BEGIN INCL(HoldR, r)
  426.     END HoldTempR;
  427.     PROCEDURE UnholdTempR* (r: LONGINT);
  428.     BEGIN EXCL(HoldR, r)
  429.     END UnholdTempR;
  430.     PROCEDURE LockParR* (r: LONGINT);
  431.     BEGIN
  432.         EXCL(TempR, r); INCL(ParR, r)
  433.     END LockParR;
  434.     PROCEDURE LockParF* (r: LONGINT);
  435.     BEGIN
  436.         EXCL(TempF, r); INCL(ParF, r)
  437.     END LockParF;
  438.     PROCEDURE FreePar*;
  439.     BEGIN
  440.         TempR := TempR+ParR; ParR := {}; TempF := TempF+ParF; ParF := {}
  441.     END FreePar;
  442. (*    old version pre october 1995
  443.     PROCEDURE AllocConst* (VAR s: ARRAY OF SYSTEM.BYTE; len: LONGINT; VAR adr: LONGINT; align: SHORTINT);
  444.         VAR fill: LONGINT;
  445.     BEGIN
  446.         fill := (conx-len) MOD align;
  447.         WHILE fill > 0 DO DEC(conx); constant[conx] := 0X; DEC(fill) END;
  448.         conx := SHORT(conx-len); IF conx < 255 THEN OPM.err(230); conx := ConstLength END;
  449.         adr := conx-ConstLength; SYSTEM.MOVE(SYSTEM.ADR(s[0]), SYSTEM.ADR(constant[conx]), len)
  450.     END AllocConst;
  451.         PROCEDURE AllocConst* (VAR s: ARRAY OF SYSTEM.BYTE; len: LONGINT; VAR adr: LONGINT; align: SHORTINT);
  452.                 VAR fill: LONGINT;
  453.         BEGIN
  454.                 fill := (conx-len) MOD align;
  455.                 WHILE fill > 0 DO DEC(conx); constant[conx] := 0X; DEC(fill) END;
  456.                 conx := SHORT(conx-len);
  457.                 IF conx < 0 THEN OPM.err(230); conx := ConstLength; adr := 0
  458.                 ELSE adr := conx-ConstLength; SYSTEM.MOVE(SYSTEM.ADR(s[0]), SYSTEM.ADR(constant[conx]), len)
  459.                 END
  460.         END AllocConst;
  461.     PROCEDURE AllocTypDesc* (typ: OPT.Struct);
  462.         VAR nil: LONGINT;
  463.     BEGIN
  464.         ASSERT(typ^.comp IN {Record, Array});
  465.         IF typ^.comp = Record THEN
  466.             nil := 0; AllocConst(nil, 4, typ^.tdadr, 4);
  467.             IF typ^.extlev > MaxExts THEN OPM.err(233)
  468.             ELSIF nofrec < MaxRecs THEN
  469.                 recTab[nofrec] := typ; INC(nofrec)
  470.             ELSE OPM.err(223)
  471.             END
  472.         END (* no type desc for arrays *)
  473.     END AllocTypDesc;
  474.     PROCEDURE AllocCaseTable* (high: LONGINT; VAR table: LONGINT);
  475.         VAR tab: ARRAY 512 OF LONGINT; l: INTEGER; i: LONGINT;
  476.     BEGIN
  477.         IF CaseLink = OPM.LANotAlloc THEN
  478.             IF noflk < MaxLinks THEN
  479.                 l := noflk; INC(noflk); links[l].pos := 0; links[l].mod := LinkMTag; links[l].ent := CaseE2Tag;
  480.                 CaseLink := l
  481.             ELSE OPM.err(231); l := 0; CaseLink := l
  482.             END
  483.         ELSE l := CaseLink
  484.         END;
  485.         tab[0] := links[l].pos*10000H; tab[1] := high*10000H; INC(high); IF high < 3 THEN high := 3 END;
  486.         i := 2; WHILE i < high DO tab[i] := 0; INC(i) END;
  487.         AllocConst(tab, high*4, table, 4);
  488.         IF l >= 0 THEN links[l].pos := SHORT(table) END
  489.     END AllocCaseTable;
  490.     PROCEDURE AllocLinkTable* (noMod: LONGINT);
  491.         VAR x: ARRAY 32 OF LONGINT; i: LONGINT;
  492.     BEGIN
  493.         i := 0; WHILE i < 32 DO x[i] := 0; INC(i) END;
  494.         AllocConst(x, noMod*4, linkTable, 4)
  495.     END AllocLinkTable;
  496.     PROCEDURE Put* (instr: LONGINT);
  497.     BEGIN code[pc] := instr; INC(pc)
  498.     END Put;
  499.     PROCEDURE Link* (VAR link: LONGINT; mod, ent: CHAR): LONGINT;
  500.         VAR l, v: LONGINT;
  501.     BEGIN
  502.         l := link;
  503.         IF l = OPM.LANotAlloc THEN
  504.             IF noflk < MaxLinks THEN
  505.                 l := noflk; INC(noflk); links[l].pos := 0; links[l].mod := mod; links[l].ent := ent
  506.             ELSE OPM.err(231); l := 0
  507.             END
  508.         END;
  509.         link := l; v := links[l].pos; links[l].pos := SHORT(-pc); RETURN v
  510.     END Link;
  511.     PROCEDURE PutLCall* (VAR x: Item);
  512.         VAR p: LONGINT; 
  513.     BEGIN
  514.         IF x.mode = XProc THEN p := entry[x.offset] ELSE p := x.offset END;
  515.         IF p < -1 THEN Put(iB+(p MOD 1000000H)*4+fLK)
  516.         ELSIF p = -1 THEN Put(iB+fLK)
  517.         ELSE Put(iB+((p-pc) MOD 1000000H)*4+fLK)
  518.         END;
  519.         IF p < 0 THEN
  520.             IF x.mode = XProc THEN entry[x.offset] := SHORT(1-pc) ELSE x.offset := 1-pc END
  521.         END
  522.     END PutLCall;
  523.     PROCEDURE PutXCall* (VAR x: Item);
  524.         VAR lval: LONGINT;
  525.     BEGIN
  526.         lval := Link(x.adr, CHR(-x.mnolev), CHR(x.offset));
  527.         Put(iB+(lval MOD 1000000H)*4+fLK)
  528.     END PutXCall;
  529.     PROCEDURE LoadProcAddr* (VAR x: Item; rt: LONGINT);
  530.         VAR t: LONGINT;
  531.     BEGIN
  532.         t := GetTempR(); FreeTempR(t);
  533.         Put(iCAU+t*fRT+(Link(x.adr, CHR(-x.mnolev), CHR(x.offset)) MOD LowWord));
  534.         IF rt < 0 THEN rt := GetTempR() END;
  535.         Put(iCAL+rt*fRT+t*fRA);
  536.         x.mode := Reg; x.reg := rt; x.typ := OPT.linttyp
  537.     END LoadProcAddr;
  538.        PROCEDURE SaveRegisters* (VAR x: Item; VAR saved: SaveDesc; VAR sSize: LONGINT);
  539.                VAR offset, i, t: LONGINT; toSave: SET; procReg: BOOLEAN;
  540.        BEGIN
  541.                offset := saveStart; toSave := TempFRegs-TempF; saved.savedF := toSave; i := 0;
  542.                REPEAT
  543.                        IF i IN toSave THEN DEC(offset, 8); Put(iSTFD+i*fFRS+FP*fRA+(offset MOD LowWord)) END;
  544.                        INC(i)
  545.                UNTIL i = 32;
  546.                toSave := TempCRFields-TempCRF; saved.CRFreg := -1;
  547.                IF (toSave # {}) OR CRF0used THEN t := GetTempR(); saved.CRFreg := t; Put(iMFCR+t*fRT) END;
  548.                toSave := TempRegs-TempR;
  549.                saved.savedR := toSave; i := 0;
  550.                REPEAT
  551.                        IF i IN toSave THEN DEC(offset, 4); Put(iST+i*fRS+FP*fRA+(offset MOD LowWord)) END;
  552.                        INC(i)
  553.                UNTIL i = 32;
  554.                TempR := TempRegs; TempF := TempFRegs; saved.ParR := ParR; saved.ParF := ParF; ParR := {}; ParF := {};
  555.                saved.offset := offset; saveStart := offset;
  556.                offset := (-offset)-SLsize; IF sSize < offset THEN sSize := offset END;
  557.        END SaveRegisters;
  558.        PROCEDURE RestoreRegisters* (VAR x: Item; VAR saved: SaveDesc; rt: LONGINT);
  559.                VAR offset, i: LONGINT; toRest: SET;
  560.        BEGIN
  561.                TempR := TempRegs-saved.savedR; TempF := TempFRegs-saved.savedF; ParR := saved.ParR; ParF := saved.ParF;
  562.                offset := saved.offset; toRest := saved.savedR;
  563.                IF x.typ^.form = ProcTyp THEN
  564.                        IF {3,4}*toRest # {} THEN
  565.                                IF rt < 0 THEN rt := GetTempRegs(2, {}) END;
  566.                                Put(iMR+3*fRA+rt*fRT); Put(iMR+4*fRA+(rt+1)*fRT); x.reg := rt
  567.                        ELSE TempR := TempR - {3,4}
  568.                        END
  569.                ELSIF x.mode = Reg THEN
  570.                        IF 3 IN toRest THEN
  571.                                IF rt < 0 THEN rt := GetTempR() END;
  572.                                Put(iMR+3*fRA+rt*fRT); x.reg := rt
  573.                        ELSE EXCL(TempR, 3)
  574.                        END
  575.                END;
  576.                i := 31;
  577.                REPEAT
  578.                        IF i IN toRest THEN Put(iL+i*fRT+FP*fRA+(offset MOD LowWord)); INC(offset, 4) END;
  579.                        DEC(i)
  580.                UNTIL i < 0;
  581.                IF saved.CRFreg # -1 THEN Put(iMTCR+saved.CRFreg*fRS); FreeTempR(saved.CRFreg) END;   (* << mmb 7.2.95 *)
  582.                toRest := saved.savedF;
  583.                IF x.mode = FReg THEN
  584.                        IF 1 IN toRest THEN
  585.                                IF rt < 0 THEN rt := GetTempF() END;
  586.                                Put(iFMR+1*fFRB+rt*fFRT); x.reg := rt
  587.                        ELSE EXCL(TempF, 1)
  588.                        END
  589.                END;
  590.                i := 31;
  591.                REPEAT
  592.                        IF i IN toRest THEN Put(iLFD+i*fFRT+FP*fRA+(offset MOD LowWord)); INC(offset, 8) END;
  593.                        DEC(i)
  594.                UNTIL i < 0;
  595.                saveStart := offset
  596.        END RestoreRegisters;
  597.     PROCEDURE FixCase* (low, high, table: LONGINT);    (* note: this procedure is dependent on big-endian ordering *)
  598.         VAR adr: LONGINT; val: INTEGER;
  599.     BEGIN
  600.         val := SHORT(pc);
  601.         adr := SYSTEM.ADR(constant[ConstLength+table+low*4]);
  602.         WHILE low <= high DO SYSTEM.PUT(adr+2, val); INC(low); INC(adr, 4) END
  603.     END FixCase;
  604.     PROCEDURE SetCaseBranch* (table: LONGINT);    (* note: this procedure is dependent on big-endian ordering *)
  605.         VAR adr: LONGINT; val: INTEGER;
  606.     BEGIN
  607.         val := SHORT(pc);
  608.         adr := SYSTEM.ADR(constant[ConstLength+table+2*4]);
  609.         SYSTEM.PUT(adr, val)
  610.     END SetCaseBranch;
  611.     PROCEDURE Fixup* (VAR l: Label);
  612.         VAR ll, instr, link, op, assh: LONGINT;
  613.     BEGIN
  614.         IF l # 0 THEN ll := (l MOD LowWord) + 0FFFF0000H ELSE ll := 0 END;
  615.         WHILE ll # 0 DO
  616.             instr := code[-ll]; link := instr MOD 4000000H; op := instr-link;
  617.             assh := SYSTEM.LSH(op, -26); ASSERT((assh = 16) OR (assh = 18));
  618.             IF op = iB THEN code[-ll] := op+(pc+ll)*4+fLK
  619.             ELSE code[-ll] := instr-(instr MOD LowWord)+(pc+ll)*4
  620.             END;
  621.             ll := instr DIV 4 MOD 4000H;
  622.             IF ll # 0 THEN INC(ll, 0FFFFC000H) END
  623.         END;
  624.         l := SHORT(pc)
  625.     END Fixup;
  626.     PROCEDURE SetTrap* (trapno: INTEGER);
  627.     BEGIN
  628.         IF noftraps < MaxTraps THEN
  629.             Traps[noftraps].no := trapno; Traps[noftraps].pc := SHORT(pc); INC(noftraps)
  630.         ELSE OPM.err(236)
  631.         END
  632.     END SetTrap;
  633.     PROCEDURE GenProcEntry* (fsize, ralloc, falloc, calloc, FP: LONGINT; leaf, nested: BOOLEAN);
  634.         VAR t1, t2: LONGINT; p: Item;
  635.     BEGIN
  636.         IF ~leaf THEN Put(iMFSPR+spLR*fSPR) END;
  637.         Put(iSTM+(ralloc+1)*fRS+SP*fRA+((ralloc-31) MOD 4000H)*4);
  638.         IF falloc < 31 THEN
  639.             ASSERT(12 IN TempR);
  640.             t1 := (32-ralloc-(ralloc MOD 2))*4+(32-falloc)*8; Put(iCAL+12*fRT+SP*fRA+((-t1) MOD LowWord));
  641.             p.mode := XProc; p.mnolev := -SYSTEM.VAL(SHORTINT, SYSMTag); p.offset := falloc+1;
  642.             p.adr := SaveFEntry[falloc-13]; PutXCall(p)
  643.         END;
  644.         IF calloc < 19 THEN t1 := GetTempR(); FreeTempR(t1); Put(iMFCR+t1*fRT) END;
  645.         IF ~leaf THEN Put(iST+SP*fRA+8) END;
  646.         IF calloc < 19 THEN Put(iST+t1*fRS+SP*fRA+4) END;
  647.         procStart := pc;
  648.         IF fsize < 32767-512 THEN
  649.             Put(iSTU+SP*fRS+SP*fRA)
  650.         ELSE
  651.             t1 := GetTempR(); FreeTempR(t1); Put(iCAU+t1*fRT);
  652.             t2 := GetTempR(); FreeTempR(t2); Put(iCAL+t2*fRT+t1*fRA);
  653.             Put(iSTUX+SP*fRT+SP*fRA+t2*fRB)
  654.         END;
  655.         Put(iCAL+FP*fRT+SP*fRA); saveStart := 0; SLsize := 0;
  656.         IF ~leaf THEN Put(iST+SB*fRS+SP*fRA+20) END;    (* save SB *)
  657.         IF nested THEN saveStart := -8; SLsize := 8 END
  658.     END GenProcEntry;
  659.     PROCEDURE GenProcExit* (fsize, psize, ralloc, falloc, calloc, FP: LONGINT; leaf: BOOLEAN);
  660.         VAR u, l, t: LONGINT; SPreset: BOOLEAN; p: Item;
  661.     BEGIN
  662.         IF psize > 512-6*4 THEN OPM.err(302) END;
  663.         IF fsize < 32767-512 THEN
  664.             INC(code[procStart], (-fsize-psize) MOD LowWord); INC(code[procStart+1], psize)
  665.         ELSE
  666.             u := -fsize-psize; l := u MOD LowWord; u := (SYSTEM.LSH(u, -16)+SYSTEM.LSH(l, -15)) MOD LowWord;
  667.             INC(code[procStart], u); INC(code[procStart+1], l); INC(code[procStart+3], psize)
  668.         END;
  669.         SPreset := fsize >= 32767-512;
  670.         IF SPreset THEN Put(iL+SP*fRT+SP*fRA); fsize := 0; FP := SP END;
  671.         IF ~leaf THEN Put(iL+FP*fRA+fsize+8) END;
  672.         IF calloc < 19 THEN t := GetTempR();
  673.             IF (falloc < 31) & (t = 12) THEN FreeTempR(t); t := GetTempR() END;
  674.             Put(iL+t*fRT+FP*fRA+fsize+4)
  675.         END;
  676.         IF ~SPreset THEN Put(iL+SP*fRT+SP*fRA) END;
  677.         IF falloc < 31 THEN
  678.             ASSERT(12 IN TempR);
  679.             u := (32-ralloc-(ralloc MOD 2))*4+(32-falloc)*8; Put(iCAL+12*fRT+SP*fRA+((-u) MOD LowWord));
  680.             p.mode := XProc; p.mnolev := -SYSTEM.VAL(SHORTINT, SYSMTag); p.offset := falloc+33;
  681.             p.adr := RestFEntry[falloc-13]; PutXCall(p)
  682.         END;
  683.         IF ~leaf THEN Put(iMTSPR+spLR*fSPR) END;
  684.         IF calloc < 19 THEN FreeTempR(t); Put(iMTCR+t*fRS) END;
  685.         Put(iLM+(ralloc+1)*fRS+SP*fRA+((ralloc-31) MOD 4000H)*4);
  686.         Put(iBCR+cALWAYS*fBO)
  687.     END GenProcExit;
  688.     PROCEDURE FixupFP* (FPlink, FPlink4: Label; psize: LONGINT);
  689.         VAR h: LONGINT;
  690.     BEGIN
  691.         WHILE FPlink # 0 DO
  692.             h := code[-FPlink]; code[-FPlink] := h-(h MOD LowWord)+psize;
  693.             FPlink := SHORT(ASH(SYSTEM.LSH(h, 16), -16))
  694.         END;
  695.         WHILE FPlink4 # 0 DO
  696.             h := code[-FPlink4]; code[-FPlink4] := h-(h MOD LowWord)+psize-4;
  697.             FPlink4 := SHORT(ASH(SYSTEM.LSH(h, 16), -16))
  698.         END
  699.     END FixupFP;
  700.     PROCEDURE EndStat*;
  701.     BEGIN
  702.         ASSERT((TempR = TempRegs) & (TempF = TempFRegs) & (TempCRF = TempCRFields) &
  703.                 (TempCRB = {}) & (ParR = {}) & (ParF = {}) & (HoldR = {}))
  704.     END EndStat;
  705.     PROCEDURE OutNum (i: LONGINT);
  706.     BEGIN
  707.         WHILE (i < -64) OR (i > 63) DO
  708.             OPM.RefW(CHR(i MOD 128 + 128)); i := i DIV 128
  709.         END;
  710.         OPM.RefW(CHR(i MOD 128))
  711.     END OutNum;
  712.     PROCEDURE OutRefPoint* (fsize, psize, ralloc, falloc, calloc: LONGINT; leaf: BOOLEAN);
  713.     BEGIN
  714.         OPM.RefW(0F8X); OutNum(pc);
  715.         OutNum(fsize); OutNum(psize); OutNum(ralloc); OutNum(falloc); OutNum(calloc);
  716.         OPM.RefW(SYSTEM.VAL(CHAR, leaf))
  717.     END OutRefPoint;
  718.     PROCEDURE OutRefName* (name: ARRAY OF CHAR);
  719.         VAR ch: CHAR; i: INTEGER;
  720.     BEGIN i := 0;
  721.         REPEAT ch := name[i]; OPM.RefW(ch); INC(i) UNTIL ch = 0X
  722.     END OutRefName;
  723.     PROCEDURE OutRefProcTyp (proc: OPT.Struct);   (* MK *)
  724.         VAR fp: LONGINT; p: OPT.Object;
  725.     BEGIN p := proc^.link;
  726.         fp := proc^.BaseTyp^.form;
  727.         WHILE p # NIL DO
  728.             fp := fp + p^.mode * p^.typ^.form;
  729.             p := p^.link
  730.         END ;
  731.         OPM.RefWNum(fp)
  732.     END OutRefProcTyp;
  733.     PROCEDURE OutRefTyp(typ: OPT.Struct);    (* MK *)
  734.     BEGIN
  735.         IF typ^.form = ProcTyp THEN
  736.             IF typ^.sysflag = 0 THEN OPM.RefW(CHR(ProcTyp)); OutRefProcTyp(typ) ELSE OPM.RefW(CHR(LInt)) END
  737.         ELSIF typ^.comp = Basic THEN OPM.RefW(CHR(typ^.form));
  738.             IF typ^.form = Pointer THEN OutRefTyp(typ^.BaseTyp) END
  739.         ELSIF typ^.comp = Array THEN OPM.RefW(0FX); OPM.RefWNum(typ^.n); OPM.RefWNum(typ^.BaseTyp^.size); OutRefTyp(typ^.BaseTyp)
  740.         ELSIF typ^.comp = Record THEN OPM.RefW(10X); OPM.RefW(CHR(typ^.mno)); OPM.RefWNum(typ^.tdadr)
  741.         ELSIF typ^.comp = DynArr THEN OPM.RefW(11X); OPM.RefWNum(typ^.BaseTyp^.size); OutRefTyp(typ^.BaseTyp)
  742.         END
  743.     END OutRefTyp;
  744.     PROCEDURE OutRefObj(o: OPT.Object; adr: LONGINT; vis: SHORTINT);    (* MK *)
  745.     BEGIN OutRefName(o.name); OPM.RefWNum(adr); OutRefTyp(o^.typ)
  746.     END OutRefObj;
  747. (* Old version of OutRefs before MK 
  748.     PROCEDURE OutRefs* (obj: OPT.Object);   (* MK *)
  749.     BEGIN 
  750.         IF obj # NIL THEN
  751.             OutRefs(obj^.left); 
  752.             IF (obj^.mode = Var) OR (obj^.mode = VarPar) THEN
  753.                 OPM.RefW(CHR(obj^.mode)); 
  754.                 OutRefObj(obj, obj^.linkadr, 0) 
  755.             END ;
  756.             OutRefs(obj^.right)
  757.         END
  758.     END OutRefs;
  759.     PROCEDURE Wi(n: LONGINT);
  760.     BEGIN OPM.ObjWInt(SHORT(n))
  761.     END Wi;
  762.     PROCEDURE Wli(n: LONGINT);
  763.     BEGIN OPM.ObjWBytes(n, 4)
  764.     END Wli;
  765.     PROCEDURE Init* (opt: SET);
  766.         VAR i: INTEGER;
  767.     BEGIN
  768.         pc := 0; conx := ConstLength; nofrec := 0; level := 0;
  769.         TempR := TempRegs; TempF := TempFRegs; TempRpos := 0; TempFpos := 0; dsize := 0; entno := 1;
  770.         TempCRF := TempCRFields; TempCRB := {}; TempCRFpos := 0; TempCRBpos := 0; ParR := {}; ParF := {};
  771.         CRF0used := FALSE; HoldR := {};
  772.         i := 0; WHILE i < MaxEntry DO entry[i] := -1; INC(i) END;
  773.         i := 0; WHILE i < 31-13 DO SaveFEntry[i] := -1; RestFEntry[i] := -1; INC(i) END;
  774.         noflk := 0; noftraps := 0; CaseLink := OPM.LANotAlloc
  775.     END Init;
  776.     PROCEDURE FindPtrs* (typ: OPT.Struct; adr: LONGINT; VAR tab: ARRAY OF LONGINT; VAR last: INTEGER);
  777.         VAR fld: OPT.Object; btyp: OPT.Struct; i, n: LONGINT; last1: INTEGER;
  778.     BEGIN
  779.         IF typ^.form = Pointer THEN
  780.             IF last < LEN(tab) THEN tab[last] := adr; INC(last) END
  781.         ELSIF typ^.comp = Record THEN
  782.             btyp := typ^.BaseTyp;
  783.             IF btyp # NIL THEN FindPtrs(btyp, adr, tab, last) END ;
  784.             fld := typ^.link;
  785.             WHILE (fld # NIL) & (fld^.mode = Fld) DO
  786.                 IF fld^.name = OPM.HdPtrName THEN
  787.                     IF last < LEN(tab) THEN tab[last] := fld^.adr+adr; INC(last) END
  788.                 ELSE FindPtrs(fld^.typ, fld^.adr + adr, tab, last)
  789.                 END ;
  790.                 fld := fld^.link
  791.             END
  792.         ELSIF typ^.comp = Array THEN
  793.             btyp := typ^.BaseTyp; n := typ^.n;
  794.             WHILE btyp^.comp = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ;
  795.             IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN
  796.                 last1 := last; FindPtrs(btyp, adr, tab, last);
  797.                 IF last # last1 THEN i := 1;
  798.                     WHILE (i < n) & (last < LEN(tab)) DO
  799.                         INC(adr, btyp^.size); FindPtrs(btyp, adr, tab, last); INC(i)
  800.                     END
  801.                 END
  802.             END
  803.         END
  804.     END FindPtrs;
  805.     PROCEDURE Close*;
  806.         VAR i: INTEGER;
  807.     BEGIN i := 0;
  808.         WHILE i < MaxRecs DO recTab[i] := NIL; INC(i) END
  809.     END Close;
  810.     PROCEDURE OutRefRec(typ: OPT.Struct; eno: INTEGER);   (* MK *)
  811.         VAR f: OPT.Object;
  812.     BEGIN
  813.         f := typ^.link;
  814.         OPM.RefW(0F7X); OPM.RefW(CHR(eno));
  815.         IF (typ^.strobj # NIL) & (typ^.strobj^.mnolev = 0) THEN OutRefName(typ^.strobj.name)
  816.         ELSE OPM.RefW(1X)
  817.         END ;
  818.         WHILE (f # NIL) & (f.mode = Fld) DO OutRefObj(f, f^.adr, f^.vis); f := f^.link END ;
  819.         OPM.RefW(0X)    (* sentinel *)
  820.     END OutRefRec;
  821.     PROCEDURE OutCode* (VAR modName: ARRAY OF CHAR; key: LONGINT);
  822.         VAR
  823.             i, nofcom,  nofnewmth, nofinhmth, nofptrs: INTEGER;
  824.             k, pos: LONGINT;
  825.             obj: OPT.Object;
  826.             typ, btyp: OPT.Struct;
  827.             ComTab: ARRAY MaxComs OF OPT.Object;
  828.             NewMthTab: ARRAY MaxEntry OF OPT.Object;
  829.             gptrTab: ARRAY OPM.MaxGPtr+1 OF LONGINT;
  830.             ptrTab: ARRAY OPM.MaxPtr+1 OF LONGINT;
  831.         PROCEDURE WriteName (VAR name: ARRAY OF CHAR);
  832.             VAR i: INTEGER; ch: CHAR;
  833.         BEGIN i := 0;
  834.             REPEAT ch := name[i]; OPM.ObjW(ch); INC(i)
  835.             UNTIL ch = 0X
  836.         END WriteName;
  837.         PROCEDURE traverse (obj: OPT.Object);
  838.             VAR u: INTEGER;
  839.         BEGIN
  840.             IF obj # NIL THEN
  841.                 IF obj^.mode = XProc THEN
  842.                     IF (obj^.vis # internal) & (obj^.link = NIL) & (obj^.typ = OPT.notyp) THEN (*command*)
  843.                         u := 0;
  844.                         WHILE obj^.name[u] > 0X DO INC(u) END;
  845.                         IF nofcom < MaxComs THEN ComTab[nofcom] := obj; INC(nofcom)
  846.                         ELSE OPM.err(232); nofcom := 0
  847.                         END
  848.                     END
  849.                 ELSIF obj^.mode = Var THEN
  850.                     FindPtrs(obj^.typ, obj^.adr, gptrTab, nofptrs)
  851.                 END;
  852.                 traverse(obj^.left); traverse(obj^.right)
  853.             END
  854.         END traverse;
  855.         PROCEDURE FindNewMths (obj: OPT.Object);
  856.         BEGIN
  857.             IF obj # NIL THEN
  858.                 IF obj^.mode = TProc THEN NewMthTab[nofnewmth] := obj; INC(nofnewmth) END ;
  859.                 FindNewMths(obj^.left); FindNewMths(obj^.right)
  860.             END
  861.         END FindNewMths;
  862.     BEGIN
  863.         i := conx MOD 8;
  864.         WHILE i > 0 DO DEC(conx); constant[conx] := 0X; DEC(i) END;
  865.         pos := OPM.RefPos (); (* MK *)
  866.         nofcom := 0; nofptrs := 0;
  867.         traverse(OPT.topScope^.right); (*collect commands and pointers*)
  868.         IF nofptrs > OPM.MaxGPtr THEN OPM.err(222) END;
  869.         i := 0;
  870.     (*header block*)
  871.         OPM.ObjWInt(entno); OPM.ObjWInt(nofcom); OPM.ObjWInt(nofptrs); OPM.ObjWInt(nofrec);
  872.         OPM.ObjWInt(OPT.nofGmod); OPM.ObjWInt(SHORT(linkTable)); OPM.ObjWInt(noflk);
  873.         OPM.ObjWBytes(dsize, 4); OPM.ObjWInt(ConstLength-conx); OPM.ObjWInt(SHORT(pc));
  874.         OPM.ObjWInt(noftraps); OPM.ObjWBytes(key, 4); WriteName(modName);
  875.     (*entry type data block, relativ to code base *)
  876.         OPM.ObjW(82X); i := 0;
  877.         WHILE i < entno DO OPM.ObjWInt(entry[i]); INC(i) END;
  878.     (*command block*)
  879.         OPM.ObjW(83X);
  880.         i := 0;  (*write command names and entry addresses*)
  881.         WHILE i < nofcom DO
  882.             obj := ComTab[i]; WriteName(obj^.name); OPM.ObjWInt(entry[obj^.adr]); INC(i)
  883.         END; 
  884.     (*pointer block*)
  885.         OPM.ObjW(84X);
  886.         i := 0; WHILE i < nofptrs DO OPM.ObjWBytes(gptrTab[i], 4); INC(i) END;
  887.     (*import block*)
  888.         OPM.ObjW(85X); i := 0;
  889.         WHILE i < OPT.nofGmod DO
  890.             obj := OPT.GlbMod[i];
  891.             OPM.ObjWBytes(obj^.adr, 4); WriteName(obj^.name);
  892.             INC(i) 
  893.         END;
  894.     (*link block*)
  895.         OPM.ObjW(86X); i := 0;
  896.         WHILE i < noflk DO
  897.             OPM.ObjW(links[i].mod); OPM.ObjW(links[i].ent); OPM.ObjWInt(links[i].pos); INC(i)
  898.         END;
  899.     (*data block*)
  900.         OPM.ObjW(87X); i := conx;
  901.         WHILE i < ConstLength DO OPM.ObjW(constant[i]); INC(i) END;
  902.     (*code block*)
  903.         OPM.ObjW(88X); i := 0;
  904.         WHILE i < pc DO OPM.ObjWBytes(code[i], 4); INC(i) END;
  905.     (*type block*)
  906.         OPM.ObjW(89X); i := 0;
  907.         WHILE i < nofrec DO
  908.             typ := recTab[i]; nofptrs := 0; FindPtrs(typ, 0, ptrTab, nofptrs);
  909.             IF nofptrs > OPM.MaxPtr THEN OPM.err(221) END;
  910.             OPM.ObjWBytes(typ^.size, 4); (*rec size*)
  911.             OPM.ObjWInt(SHORT(typ^.tdadr)); (*td adr*)
  912.             btyp := typ^.BaseTyp;
  913.             IF btyp = NIL THEN nofinhmth := 0; OPM.ObjWInt(-1); OPM.ObjWInt(-1)
  914.             ELSE nofinhmth := SHORT(btyp^.n);
  915.                 OPM.ObjWInt(btyp^.mno); OPM.ObjWInt(SHORT(btyp^.tdadr))    (* base td, loader must copy its ptrs *)
  916.             END;
  917.             OPM.ObjWInt(SHORT(typ^.n));    (* total number of methods *)
  918.             OPM.ObjWInt(nofinhmth);    (* number of inherited methods *)
  919.             nofnewmth := 0; FindNewMths(typ^.link);
  920.             OPM.ObjWInt(nofnewmth);
  921.             OPM.ObjWInt(nofptrs);
  922.             IF (typ^.strobj # NIL) & (typ^.strobj^.mnolev = 0) THEN WriteName(typ^.strobj^.name)
  923.             ELSE OPM.ObjW(0X)
  924.             END;
  925.             WHILE nofnewmth > 0 DO DEC(nofnewmth);
  926.                 OPM.ObjWInt(SHORT(NewMthTab[nofnewmth]^.adr DIV 10000H));    (* mthno *)
  927.                 OPM.ObjWInt(SHORT(NewMthTab[nofnewmth]^.adr MOD 10000H));    (* entno *)
  928.             END;
  929.             k := 0; WHILE k < nofptrs DO OPM.ObjWBytes(ptrTab[k], 4); INC(k) END;
  930.             IF i < nofrec THEN OutRefRec(recTab[i], SHORT(entno + i)) END;  (* MK *)
  931.             INC(i)
  932.         END;
  933.     (*trap block*)
  934.         OPM.ObjW(8AX);
  935.         i := 0; WHILE i < noftraps DO OPM.ObjWInt(Traps[i].pc); OPM.ObjWInt(Traps[i].no); INC(i) END;
  936.     (*ref block written in OPM.CloseRefFile *)
  937.     END OutCode;
  938. END POPL.
  939.